MODULE TFGenJava;

IMPORT
	TS := TFTypeSys, TFAOParser, MultiLogger, Streams, Trace, Commands, KernelLog, Kernel;
	
VAR w : Streams.Writer;
	ml : MultiLogger.LogWindow;
	indent : LONGINT;
	
PROCEDURE Indent;
VAR i : LONGINT;
BEGIN
	FOR i := 0 TO indent - 1 DO w.Char(09X) END
END Indent;
	
	
PROCEDURE DumpConst(c : TS.Const);
BEGIN
	Indent; 
	IF c.exportState * {TS.ExportReadWrite, TS.ExportReadOnly} # {} THEN 
		w.String("public ");
	END;
	w.String("final ");
	w.String("int "); (* $$$ *)
	w.String(c.name^); 
	w.String(" = "); 
	DumpExpression(c.expression);
	w.String(";");
	w.Ln;
END DumpConst;

PROCEDURE DumpObject(o : TS.Class);
BEGIN
	Indent; w.String("public class "); 
	IF o.scope.super # NIL THEN 
		w.Char("(");
	(*	DumpDesignator(o.super); *)
		w.Char(")");
	END;
	w.Ln;
	INC(indent); DumpDeclarations(o.scope); DEC(indent);
	
	Indent; w.String("END "); w.Ln
END DumpObject;

PROCEDURE DumpArray(a : TS.Array);
BEGIN
	DumpType(a.base); w.String("[] ");
END DumpArray;

PROCEDURE DumpRecord(r : TS.Record);
BEGIN
	Indent; w.String("RECORD")
END DumpRecord;

PROCEDURE DumpProcedure(p : TS.ProcedureType);
BEGIN

	Indent; w.String("PROCEDURE");
END DumpProcedure;


PROCEDURE DumpDesignator(d : TS.Designator);
VAR s : ARRAY 64 OF CHAR;
BEGIN
	IF d IS TS.Ident THEN TS.s.GetString(d(TS.Ident).name, s); 
		IF s = "INTEGER" THEN s := "int"
		ELSIF s = "LONGINT" THEN s := "int"
		ELSIF s = "HUGEINT" THEN s := "long"
		ELSIF s = "REAL" THEN s := "float"
		ELSIF s = "LONGREAL" THEN s := "double"
		ELSIF s = "BOOLEAN" THEN s := "boolean"
		ELSIF s = "CHAR" THEN s := "char"
		END;
		w.String(s);
	ELSIF d IS TS.Index THEN
		w.String("[");
		DumpExpressionList(d(TS.Index).expressionList);
		w.String("]");
	ELSIF d IS TS.ActualParameters THEN
		w.String("(");
		DumpExpressionList(d(TS.ActualParameters).expressionList);
		w.String(")");
	END;
	IF (d.next # NIL) THEN
		IF (d IS TS.Ident) & ((d.next IS TS.Ident))THEN w.String(".") END;
		DumpDesignator(d.next)
	END
END DumpDesignator;

PROCEDURE DumpExpressionList(e : TS.ExpressionList);
BEGIN
	WHILE e # NIL DO
		DumpExpression(e.expression);
		IF e.next # NIL THEN w.String(", ") END;
		e := e.next	
	END
END DumpExpressionList;


PROCEDURE DumpExpression(e : TS.Expression);
BEGIN
w.Update;
	IF e = NIL THEN w.String("NIL"); w.Update; RETURN END; 
	
	IF e.kind = TS.ExpressionPrimitive THEN
		IF e.basicType IN {TS.BasicInt8, TS.BasicInt16, TS.BasicInt32, TS.BasicInt64} THEN
			w.Int(SHORT(e.intValue), 0);
		ELSIF e.basicType = TS.BasicBoolean THEN
			IF e.boolValue THEN w.String("true") ELSE w.String("false") END;
		ELSIF e.basicType = TS.BasicString THEN
			w.String('"'); w.String(e.strValue^); w.String('\0".toCharArray()');
		ELSIF e.basicType = TS.BasicNIL THEN
			w.String('null');
		END
	ELSIF e.kind = TS.ExpressionUnary THEN
		CASE e.op OF
			|TS.OpNegate: w.String("-")
			|TS.OpInvert: w.String("~")
		ELSE
			Trace.String("Internal error :"); Trace.String("e.op= "); Trace.Int(e.op, 0); Trace.Ln; 
		END;
		DumpExpression(e.a);
	ELSIF e.kind = TS.ExpressionBinary THEN
		w.String("(");
		DumpExpression(e.a);
		CASE e.op OF
			|TS.OpAdd: w.String("+")
			|TS.OpSub: w.String("-")
			|TS.OpOr: w.String("||")
			|TS.OpMul: w.String("*")
			|TS.OpAnd: w.String("&&")
			|TS.OpIntDiv: w.String("/") (* if both operands are int *)
			|TS.OpMod: w.String("%")
			|TS.OpDiv: w.String("/")

			|TS.OpEql: w.String("=")
			|TS.OpNeq: w.String("!=")
			|TS.OpLss: w.String("<")
			|TS.OpLeq: w.String("<=")
			|TS.OpGtr: w.String(">")
			|TS.OpGeq: w.String(">=")
			|TS.OpIn: w.String("IN")
			|TS.OpIs: w.String("IS")
		END;
		DumpExpression(e.b);
		w.String(")");
	ELSIF e.kind = TS.ExpressionDesignator THEN
		DumpDesignator(e.designator)
	END;
END DumpExpression;


PROCEDURE DumpType*(t : TS.Type);
BEGIN
	CASE t.kind OF
		|TS.TAlias : DumpDesignator(t.qualident)
		|TS.TObject : DumpObject(t.object)
		|TS.TArray : DumpArray(t.array);
		|TS.TPointer : w.String("POINTER TO "); DumpType(t.pointer.type)
		|TS.TRecord : DumpRecord(t.record);
		|TS.TProcedure : DumpProcedure(t.procedure)
	ELSE
		w.String("XXXX"); Trace.String("Unknown Type"); Trace.String("t.kind= "); Trace.Int(t.kind, 0); Trace.Ln; 
	END
	
END DumpType;

PROCEDURE DumpCases(case : TS.Case);
VAR cr : TS.CaseRange;
BEGIN
	Indent;
	WHILE case # NIL DO
		cr := case.caseRanges;
		WHILE cr # NIL DO
			Indent; w.String("case "); DumpExpression(cr.a); w.String(":"); w.Ln; 
			IF cr.b # NIL THEN w.String(".."); DumpExpression(cr.b) END;
			IF cr.next # NIL THEN w.String(", ") END;
			cr := cr.next
		END;

		IF case.statements # NIL THEN 
			DumpStatementSequence(case.statements);
		END;
		INC(indent);
		Indent; w.String("break;"); w.Ln;
		DEC(indent);
		case := case.next
	END;
END DumpCases;

PROCEDURE DeclareDelegateWrapper(t : TS.TypeDecl);
VAR (* w : Streams.Writer;*)
	p : TS.ProcedureType;
	i : LONGINT;
	cur : TS.NamedObject;
BEGIN
	ASSERT(t.type.kind = TS.TProcedure);
	p := t.type.procedure;
	w.Char(09X); 
	IF t.exportState * {TS.ExportReadOnly, TS.ExportReadWrite} # {} THEN
		w.String("public ")
	END;
	w.String("static class "); w.String(t.name^); w.String(" {"); w.Ln;
	w.Char(09X); 
	IF t.exportState * {TS.ExportReadOnly, TS.ExportReadWrite} # {} THEN
		w.String("public ")
	END;
	
	w.String("abstract "); 
	IF p.signature = NIL THEN w.String("void")
	ELSE 
		IF p.signature.return = NIL THEN w.String("void")
		ELSE DumpType(p.signature.return)
		END
	END;
	w.String(" invoke (");
	IF (p.signature # NIL) & (p.signature.params # NIL) THEN 	
		FOR i := 0 TO p.signature.params.nofObjs - 1 DO
			cur := p.signature.params.objs[i];
			DumpType(cur(TS.Var).type); w.String(" ");
			w.String(cur.name^);
			IF i < p.signature.params.nofObjs - 1 THEN
				w.String(", ")
			END
		END
	END;
	w.String("); "); 	
	w.Ln;
	w.String("}");
	w.Ln
END DeclareDelegateWrapper;


PROCEDURE DumpTypeDecl(t : TS.TypeDecl);
BEGIN
	Indent; 
	IF t.type.kind = TS.TProcedure THEN
		DeclareDelegateWrapper(t)
	ELSE
		w.String(t.name^); w.String(" = "); DumpType(t.type);
	END;
	w.Ln
END DumpTypeDecl;

PROCEDURE DumpVar(v : TS.Var);
BEGIN
	IF v.type.kind = TS.TArray THEN
		Indent; DumpType(v.type); w.String(" "); w.String(v.name^); 
		w.String(" = new ");
		DumpType(v.type.array.base); w.String("[");DumpExpression(v.type.array.expression); w.String("]");
		w.String(";"); w.Ln
	ELSE
		Indent; DumpType(v.type); w.String(" "); w.String(v.name^); w.String(";"); w.Ln
	END
END DumpVar;

PROCEDURE DumpComments(comments : TS.Comments);
VAR cur : TS.Comment;
BEGIN
	cur := comments.first;
	WHILE cur # NIL DO
		w.Update;
		ml.tw.SetFontStyle({0});
		w.String("/*");
		w.String(cur.str^);
		w.String("*/");
		w.Update;
		ml.tw.SetFontStyle({});
		cur := cur.next
	END
END DumpComments;


PROCEDURE DumpStatementSequence(s : TS.Statement);
VAR ts : TS.Statement;
	ident : TS.Ident;
	identStr : ARRAY 64 OF CHAR;
	special : BOOLEAN;
	d : TS.Designator;
	e : TS.ExpressionList;
BEGIN
	IF s IS TS.StatementBlock THEN
		DumpStatementSequence(s(TS.StatementBlock).statements);
		RETURN
	END;
	INC(indent);
	WHILE s # NIL DO
		IF s.preComment # NIL THEN Indent; DumpComments(s.preComment); w.Ln END;
		IF s IS TS.Assignment THEN
			Indent;
			DumpDesignator(s(TS.Assignment).designator);
			w.String(" = ");
			DumpExpression(s(TS.Assignment).expression);
		ELSIF s IS TS.ProcedureCall THEN
			Indent;
			special := FALSE;
			IF s(TS.ProcedureCall).designator IS TS.Ident THEN (* internal methods *)
				ident := s(TS.ProcedureCall).designator(TS.Ident);
				TS.s.GetString(ident.name, identStr);
				IF identStr = "INC" THEN
					d := s(TS.ProcedureCall).designator;
					d := d.next;
					IF (d # NIL) & (d IS TS.ActualParameters) THEN
						e :=	d(TS.ActualParameters).expressionList;
						DumpExpression(e.expression);
						IF e.next = NIL THEN w.String("++")
						ELSE
							w.String(" += "); DumpExpression(e.next.expression);
						END;
					END;
					special := TRUE;
				ELSIF identStr = "DEC" THEN
					d := s(TS.ProcedureCall).designator;
					d := d.next;
					IF (d # NIL) & (d IS TS.ActualParameters) THEN
						e :=	d(TS.ActualParameters).expressionList;
						DumpExpression(e.expression);
						IF e.next = NIL THEN w.String("--")
						ELSE
							w.String(" -= "); DumpExpression(e.next.expression);
						END;
					END;
					special := TRUE;
				END
			END;
			IF ~special THEN DumpDesignator(s(TS.ProcedureCall).designator) END;
		ELSIF s IS TS.IFStatement THEN
			Indent;
			w.String("if (");
			DumpExpression(s(TS.IFStatement).expression);
			w.String(") { "); w.Ln;
			DumpStatementSequence(s(TS.IFStatement).then);
			Indent; w.String("}");
			ts := s(TS.IFStatement).else;
			IF ts # NIL THEN 
				Indent; w.String(" else { "); w.Ln;
				DumpStatementSequence(ts);
				Indent; w.String("}"); 
			END;
		ELSIF s IS TS.WHILEStatement THEN
			Indent; w.String("while ("); DumpExpression(s(TS.WHILEStatement).expression); 
			w.String(") {"); w.Ln;
			DumpStatementSequence(s(TS.WHILEStatement).statements);
			Indent; w.String("}")
		ELSIF s IS TS.REPEATStatement THEN
			Indent; w.String("do {"); w.Ln;
			DumpStatementSequence(s(TS.REPEATStatement).statements);
			Indent; w.String("while ("); DumpExpression(s(TS.REPEATStatement).expression); w.String(")");
		ELSIF s IS TS.LOOPStatement THEN
			Indent; w.String("while (true) {"); w.Ln;
			DumpStatementSequence(s(TS.LOOPStatement).statements);
			Indent; w.String("}") 
		ELSIF s IS TS.FORStatement THEN
			Indent; w.String("for ("); 
			DumpDesignator(s(TS.FORStatement).variable);
			w.String("  = "); DumpExpression(s(TS.FORStatement).fromExpression);
			w.String("; ");
			DumpDesignator(s(TS.FORStatement).variable);
			w.String(" <= "); DumpExpression(s(TS.FORStatement).toExpression); w.String("; ");
			(* $$$ BY not implemented *)
			(* $$$ store temp variable *)
			DumpDesignator(s(TS.FORStatement).variable);
			w.String("++;) {");
		(*	IF s(TS.FORStatement).byExpression # NIL THEN
				w.String(" BY "); DumpExpression(s(TS.FORStatement).byExpression);
			END; *)
			w.Ln;
			DumpStatementSequence(s(TS.FORStatement).statements);
			Indent; w.String("}") 
		ELSIF s IS TS.EXITStatement THEN
			Indent; w.String("exit"); 
		ELSIF s IS TS.RETURNStatement THEN
			Indent; w.String("return "); 
			IF s(TS.RETURNStatement).expression # NIL THEN DumpExpression(s(TS.RETURNStatement).expression) END;
		ELSIF s IS TS.AWAITStatement THEN
			Indent; w.String("AWAIT("); 
			DumpExpression(s(TS.AWAITStatement).expression); w.String(")")
		ELSIF s IS TS.WITHStatement THEN
			Indent; w.String("WITH "); 
			DumpDesignator(s(TS.WITHStatement).variable);
			w.String(" : "); DumpDesignator(s(TS.WITHStatement).type);
			w.String(" DO"); w.Ln;
			DumpStatementSequence(s(TS.WITHStatement).statements);
			Indent; w.String("END") 
		ELSIF s IS TS.CASEStatement THEN
			Indent; w.String("switch ("); DumpExpression(s(TS.CASEStatement).expression); w.String(") {"); w.Ln;
			DumpCases(s(TS.CASEStatement).cases);
			IF s(TS.CASEStatement).else # NIL THEN
				Indent; w.String("default: "); w.Ln;
				DumpStatementSequence(s(TS.CASEStatement).else);
				INC(indent); Indent; w.String("break;"); w.Ln;
			END;
			Indent; w.String("}") 
		END;
		IF ~(s IS TS.EmptyStatement) THEN w.String(";") END;
		IF s.postComment # NIL THEN DumpComments(s.postComment); END;
		IF ~(s IS TS.EmptyStatement) THEN w.Ln END;
		s := s.next
	END
	;DEC(indent)
	
END DumpStatementSequence;

PROCEDURE DumpProcDecl(p : TS.ProcDecl);
VAR s : TS.Statement;
	cur : TS.NamedObject; i : LONGINT;
BEGIN
	IF p.preComment # NIL THEN 
		DumpComments(p.preComment);
		w.Ln;
	END;
	Indent;
	IF p.exportState * {TS.ExportReadWrite, TS.ExportReadOnly} # {} THEN 
		w.String("public ");
	END;
	IF p.container.owner IS TS.Module THEN
		w.String("static ")	
	END;
	 
	IF p.signature = NIL THEN 
		w.String("void "); w.String(p.name^); 
	ELSE 
		IF p.signature.return = NIL THEN w.String("void ");
		ELSE DumpType(p.signature.return); w.String(" ");
		END;
		w.String(p.name^); 
	END;
	w.String("(");
	IF (p.signature # NIL) & (p.signature.params # NIL) THEN 	
		FOR i := 0 TO p.signature.params.nofObjs - 1 DO
			cur := p.signature.params.objs[i];
			DumpType(cur(TS.Var).type); w.String(" ");
			w.String(cur.name^);
			IF i < p.signature.params.nofObjs - 1 THEN
				w.String(", ")
			END
		END
	END;
	w.String(") "); 
	w.String(" { ");
	w.Ln;
	
	DumpDeclarations(p.scope);
	
	IF p.scope.ownerBody # NIL THEN 
		s := p.scope.ownerBody;
		DumpStatementSequence(s)
	END;
	Indent; w.String("};"); w.Ln; w.Ln;
END DumpProcDecl;

PROCEDURE DumpDeclarations(d : TS.Scope);
VAR i : LONGINT;
	last, cur : TS.NamedObject;
BEGIN
	IF d = NIL THEN RETURN END;
	FOR i := 0 TO d.elements.nofObjs - 1 DO
		cur := d.elements.objs[i];
		IF cur IS TS.Const THEN
			(* IF (last = NIL) OR ~(last IS TS.Const) THEN
				IF last # NIL THEN w.Ln END;
				Indent;	w.String("CONST"); w.Ln
			END; *)
			w.Char(09X); DumpConst(cur(TS.Const))
		ELSIF cur IS TS.TypeDecl THEN
			IF (last = NIL) OR ~(last IS TS.TypeDecl) THEN
				IF last # NIL THEN w.Ln END;
			END;
			Indent(); DumpTypeDecl(cur(TS.TypeDecl));
		ELSIF cur IS TS.Var THEN DumpVar(cur(TS.Var))
		ELSIF cur IS TS.ProcDecl THEN
			IF last # NIL THEN w.Ln END;
			DumpProcDecl(cur(TS.ProcDecl))
		ELSIF cur IS TS.Import THEN
		END;
		last := cur;
	END
END DumpDeclarations;

PROCEDURE GenerateModule*(m : TS.Module);
VAR i : LONGINT;
BEGIN

	IF m.scope.elements.nofObjs > 0 THEN
		FOR i := 0 TO m.scope.elements.nofObjs - 1 DO
			IF m.scope.elements.objs[i] IS TS.Import THEN
				w.String("import "); w.String(m.scope.elements.objs[i](TS.Import).import^); w.String(";"); w.Ln;
			END;
		END;
	END;
	
	w.String("public class "); w.String(m.name^);  w.String(" { "); w.Ln;
	w.Ln;
	INC(indent);
	DumpDeclarations(m.scope);
	DEC(indent);
	w.String("}"); w.Ln; w.Update
END GenerateModule;

PROCEDURE Generate*(par : Commands.Context) ;
VAR
	name :ARRAY 256 OF CHAR;
	sr : Streams.Reader;
	t0, t1 : LONGINT;
	module : TS.Module;
BEGIN
	sr := par.arg;
	sr.String(name);
	
	NEW(ml, name, w);
	KernelLog.String("Parsing "); KernelLog.String(name);  
	t0 := Kernel.GetTicks();
	TFAOParser.ScanModule(name, FALSE, module);
	IF module # NIL THEN 
		GenerateModule(module);
	END;
	t1 := Kernel.GetTicks();
	KernelLog.String("t1-t0= "); KernelLog.Int(t1-t0, 0); KernelLog.Ln; 
	KernelLog.String(" done.");
END Generate;


END TFGenJava.
 SystemTools.Free TFGenJava~
 TFGenJava.Generate Streams.Mod ~